library(rrrsa)
library(dplyr)
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
library(knitr)
source("viz_img.R")
norm_vec <- function(v) {
v / sum(v)
}
normalize_rows <- function(m) {
t(apply(m, MARGIN=1, FUN=norm_vec))
}
normalize_cols <- function(m) {
apply(m, MARGIN=2, FUN=norm_vec)
}
3X3
m3 <- matrix(c(1, 0, 1, 0, 1, 1, 1, 0, 0), nrow = 3)
L0 <- rsa.reason(normalize_cols(m3), depth=0); L0
L1 <- rsa.reason(normalize_cols(m3), depth=1); L1
L2 <- rsa.reason(normalize_cols(m3), depth=2); L2
3X4
m3 <- matrix(c(1, 1, 1, 1, 0, 1, 0, 1, 1, 1, 0, 0), nrow = 3)
L0 <- rsa.reason(normalize_cols(m3), depth=0); L0
L1 <- rsa.reason(normalize_cols(m3), depth=1); L1
L2 <- rsa.reason(normalize_cols(m3), depth=2); L2
4X4
m4 <- matrix(c(1, 0, 1, 1, 0, 1, 0, 1, 1, 1, 1, 0, 0, 0, 1, 1), nrow = 4)
L0 <- rsa.reason(normalize_cols(m4), depth=0); L0
L1 <- rsa.reason(normalize_cols(m4), depth=1); L1
L2 <- rsa.reason(normalize_cols(m4), depth=2); L2
L0; L1; L2
is_separate <- function(m1, m2) {
num_rows <- dim(m1)[1]
num_cols <- dim(m1)[2]
for (curr_col in 1:num_cols) {
if (any(duplicated(m1[,curr_col]) != duplicated(m2[,curr_col]))) return(TRUE)
}
FALSE
}
I’m working with a transposed matrix design (utterances are cols, faces are rows). So L0 normalizes over rows.
set.seed(1)
generate_random_matrix <- function(num_rows, num_cols) {
m <- matrix(sample(c(0, 1), size=num_rows * num_cols, replace=TRUE), nrow=num_rows)
}
generate_random_matrix(3, 3) %>%
data.frame %>%
kable(caption="Example generated 3X3 matrix")
| X1 | X2 | X3 |
|---|---|---|
| 0 | 1 | 1 |
| 0 | 0 | 1 |
| 1 | 1 | 1 |
bad_matrix <- function(m) {
num_rows <- dim(m)[1]
num_cols <- dim(m)[2]
for (curr_col in 1:num_cols) {
if (all(m[, curr_col] == 0)) return(TRUE)
}
for (curr_row in 1:num_rows) {
if (all(m[curr_row,] == 0)) return(TRUE)
}
FALSE
}
not_null <- function(x) !is.null(x)
good_matrices <- list()
for (i in seq(1,100)) {
curr_m <- generate_random_matrix(4, 3)
if (bad_matrix(curr_m)) next
# print(curr_m)
L0 <- rsa.reason(normalize_cols(curr_m), depth=0)
L1 <- rsa.reason(normalize_cols(curr_m), depth=1)
L2 <- rsa.reason(normalize_cols(curr_m), depth=2)
curr_matrices <- list("original"=curr_m, "L0"=L0, "L1"=L1, "L2"=L2)
if (is_separate(L1, L2)) good_matrices[[i]] <- curr_matrices
}
good_matrices_filtered <- Filter(not_null, good_matrices)
good_matrices_filtered
## [[1]]
## [[1]]$original
## [,1] [,2] [,3]
## [1,] 1 1 0
## [2,] 1 1 0
## [3,] 0 0 1
## [4,] 1 0 1
##
## [[1]]$L0
## [,1] [,2] [,3]
## [1,] 0.3333333 0.5 0.0
## [2,] 0.3333333 0.5 0.0
## [3,] 0.0000000 0.0 0.5
## [4,] 0.3333333 0.0 0.5
##
## [[1]]$L1
## 1 2 3
## [1,] 0.3333333 0.5 0.000
## [2,] 0.3333333 0.5 0.000
## [3,] 0.0000000 0.0 0.625
## [4,] 0.3333333 0.0 0.375
##
## [[1]]$L2
## 1 2 3
## [1,] 0.3148148 0.5 0.0000000
## [2,] 0.3148148 0.5 0.0000000
## [3,] 0.0000000 0.0 0.6538462
## [4,] 0.3703704 0.0 0.3461538
##
##
## [[2]]
## [[2]]$original
## [,1] [,2] [,3]
## [1,] 0 1 1
## [2,] 0 1 1
## [3,] 1 1 0
## [4,] 1 0 0
##
## [[2]]$L0
## [,1] [,2] [,3]
## [1,] 0.0 0.3333333 0.5
## [2,] 0.0 0.3333333 0.5
## [3,] 0.5 0.3333333 0.0
## [4,] 0.5 0.0000000 0.0
##
## [[2]]$L1
## 1 2 3
## [1,] 0.000 0.3333333 0.5
## [2,] 0.000 0.3333333 0.5
## [3,] 0.375 0.3333333 0.0
## [4,] 0.625 0.0000000 0.0
##
## [[2]]$L2
## 1 2 3
## [1,] 0.0000000 0.3148148 0.5
## [2,] 0.0000000 0.3148148 0.5
## [3,] 0.3461538 0.3703704 0.0
## [4,] 0.6538462 0.0000000 0.0
##
##
## [[3]]
## [[3]]$original
## [,1] [,2] [,3]
## [1,] 1 0 1
## [2,] 1 1 0
## [3,] 1 1 0
## [4,] 0 0 1
##
## [[3]]$L0
## [,1] [,2] [,3]
## [1,] 0.3333333 0.0 0.5
## [2,] 0.3333333 0.5 0.0
## [3,] 0.3333333 0.5 0.0
## [4,] 0.0000000 0.0 0.5
##
## [[3]]$L1
## 1 2 3
## [1,] 0.3333333 0.0 0.375
## [2,] 0.3333333 0.5 0.000
## [3,] 0.3333333 0.5 0.000
## [4,] 0.0000000 0.0 0.625
##
## [[3]]$L2
## 1 2 3
## [1,] 0.3703704 0.0 0.3461538
## [2,] 0.3148148 0.5 0.0000000
## [3,] 0.3148148 0.5 0.0000000
## [4,] 0.0000000 0.0 0.6538462
L2 separation always occurs in the column in which one of the features is shared by 3 out of 4 of the faces in the 3X4 or 4X3 matrix.
More types of L2 separation with a 4X4.
good_matrices <- list()
for (i in seq(1,100)) {
curr_m <- generate_random_matrix(3, 4)
if (bad_matrix(curr_m)) next
# print(curr_m)
ImageViz(t(curr_m))
L0 <- t(rsa.reason(normalize_cols(curr_m), depth=0))
L1 <- t(rsa.reason(normalize_cols(curr_m), depth=1))
L2 <- t(rsa.reason(normalize_cols(curr_m), depth=2))
L3 <- t(rsa.reason(normalize_cols(curr_m), depth=3))
curr_matrices <- list("original"=curr_m, "L0"=L0, "L1"=L1, "L2"=L2, "L3"=L3)
if (is_separate(L2, L3)) good_matrices[[i]] <- curr_matrices
}
not_null <- function(x) !is.null(x)
good_matrices_filtered <- Filter(not_null, good_matrices)
good_matrices_filtered
We get L3 separation with a 6X4 or 4X6 matrix.